home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_pas / sk210f.zip / SHCLRDEF.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-11  |  23KB  |  577 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. {$D-,L-}
  6. unit ShClrdef;
  7. {
  8.                                 ShClrDef
  9.  
  10.                           A Screen Color Unit
  11.  
  12.                                    by
  13.  
  14.                               Bill Madison
  15.  
  16.                    W. G. Madison and Associates, Ltd.
  17.                           13819 Shavano Downs
  18.                             P.O. Box 780956
  19.                        San Antonio, TX 78278-0956
  20.                              (512)492-2777
  21.                              CIS 73240,342
  22.                 Internet bill.madison@lchance.sat.tx.us
  23.  
  24.                 Copyright 1990, '94 Madison & Associates
  25.                           All Rights Reserved
  26.  
  27.         This file may  be used and distributed  only in accord-
  28.         ance with the provisions described on the title page of
  29.                   the accompanying documentation file
  30.                               SKYHAWK.DOC
  31. }
  32.  
  33. Interface
  34.  
  35. uses
  36.   tpString,
  37.   TpWindow,
  38.   TpCrt;
  39.  
  40. const
  41.   Copyr = 'Copyright 1990, 1994 by W.G. Madison';
  42.  
  43. const
  44.  
  45.         {Color constants:
  46.          Black     = 0; Blue   = 1; Green   = 2; Cyan   = 3; Red   = 4;
  47.          Magenta   = 5; Brown  = 6; LtGray  = 7;
  48.          DkGray    = 8; LtBlue = 9; LtGreen = A; LtCyan = B; LtRed = C;
  49.          LtMagenta = D; Yellow = E; White   = F
  50.          }
  51.  
  52.         {Screen color constants}
  53.         {Black text}                       {Blue text}
  54.         BlackOnBlack       = $00;          BlueOnBlack        = $01;
  55.         BlackOnBlue        = $10;          BlueOnBlue         = $11;
  56.         BlackOnGreen       = $20;          BlueOnGreen        = $21;
  57.         BlackOnCyan        = $30;          BlueOnCyan         = $31;
  58.         BlackOnRed         = $40;          BlueOnRed          = $41;
  59.         BlackOnMagenta     = $50;          BlueOnMagenta      = $51;
  60.         BlackOnBrown       = $60;          BlueOnBrown        = $61;
  61.         BlackOnLtGray      = $70;          BlueOnLtGray       = $71;
  62.  
  63.         {Green text}                       {Cyan text}
  64.         GreenOnBlack       = $02;          CyanOnBlack        = $03;
  65.         GreenOnBlue        = $12;          CyanOnBlue         = $13;
  66.         GreenOnGreen       = $22;          CyanOnGreen        = $23;
  67.         GreenOnCyan        = $32;          CyanOnCyan         = $33;
  68.         GreenOnRed         = $42;          CyanOnRed          = $43;
  69.         GreenOnMagenta     = $52;          CyanOnMagenta      = $53;
  70.         GreenOnBrown       = $62;          CyanOnBrown        = $63;
  71.         GreenOnLtGray      = $72;          CyanOnLtGray       = $73;
  72.  
  73.         {Red text}                         {Magenta text}
  74.         RedOnBlack         = $04;          MagentaOnBlack     = $05;
  75.         RedOnBlue          = $14;          MagentaOnBlue      = $15;
  76.         RedOnGreen         = $24;          MagentaOnGreen     = $25;
  77.         RedOnCyan          = $34;          MagentaOnCyan      = $35;
  78.         RedOnRed           = $44;          MagentaOnRed       = $45;
  79.         RedOnMagenta       = $54;          MagentaOnMagenta   = $55;
  80.         RedOnBrown         = $64;          MagentaOnBrown     = $65;
  81.         RedOnLtGray        = $74;          MagentaOnLtGray    = $75;
  82.  
  83.         {Brown text}                       {Light Gray text}
  84.         BrownOnBlack       = $06;          LtGrayOnBlack      = $07;
  85.         BrownOnBlue        = $16;          LtGrayOnBlue       = $17;
  86.         BrownOnGreen       = $26;          LtGrayOnGreen      = $27;
  87.         BrownOnCyan        = $36;          LtGrayOnCyan       = $37;
  88.         BrownOnRed         = $46;          LtGrayOnRed        = $47;
  89.         BrownOnMagenta     = $56;          LtGrayOnMagenta    = $57;
  90.         BrownOnBrown       = $66;          LtGrayOnBrown      = $67;
  91.         BrownOnLtGray      = $76;          LtGrayOnLtGray     = $77;
  92.  
  93.         {Dark Gray text}                   {Light Blue text}
  94.         DkGrayOnBlack      = $08;          LtBlueOnBlack      = $09;
  95.         DkGrayOnBlue       = $18;          LtBlueOnBlue       = $19;
  96.         DkGrayOnGreen      = $28;          LtBlueOnGreen      = $29;
  97.         DkGrayOnCyan       = $38;          LtBlueOnCyan       = $39;
  98.         DkGrayOnRed        = $48;          LtBlueOnRed        = $49;
  99.         DkGrayOnMagenta    = $58;          LtBlueOnMagenta    = $59;
  100.         DkGrayOnBrown      = $68;          LtBlueOnBrown      = $69;
  101.         DkGrayOnLtGray     = $78;          LtBlueOnLtGray     = $79;
  102.  
  103.         {Light Green Text}                 {Light Cyan text}
  104.         LtGreenOnBlack     = $0A;          LtCyanOnBlack      = $0B;
  105.         LtGreenOnBlue      = $1A;          LtCyanOnBlue       = $1B;
  106.         LtGreenOnGreen     = $2A;          LtCyanOnGreen      = $2B;
  107.         LtGreenOnCyan      = $3A;          LtCyanOnCyan       = $3B;
  108.         LtGreenOnRed       = $4A;          LtCyanOnRed        = $4B;
  109.         LtGreenOnMagenta   = $5A;          LtCyanOnMagenta    = $5B;
  110.         LtGreenOnBrown     = $6A;          LtCyanOnBrown      = $6B;
  111.         LtGreenOnLtGray    = $7A;          LtCyanOnLtGray     = $7B;
  112.  
  113.         {Light Red text}                   {Light Magenta text}
  114.         LtRedOnBlack       = $0C;          LtMagentaOnBlack   = $0D;
  115.         LtRedOnBlue        = $1C;          LtMagentaOnBlue    = $1D;
  116.         LtRedOnGreen       = $2C;          LtMagentaOnGreen   = $2D;
  117.         LtRedOnCyan        = $3C;          LtMagentaOnCyan    = $3D;
  118.         LtRedOnRed         = $4C;          LtMagentaOnRed     = $4D;
  119.         LtRedOnMagenta     = $5C;          LtMagentaOnMagenta = $5D;
  120.         LtRedOnBrown       = $6C;          LtMagentaOnBrown   = $6D;
  121.         LtRedOnLtGray      = $7C;          LtMagentaOnLtGray  = $7D;
  122.  
  123.         {Yellow text}                      {White text}
  124.         YellowOnBlack      = $0E;          WhiteOnBlack       = $0F;
  125.         YellowOnBlue       = $1E;          WhiteOnBlue        = $1F;
  126.         YellowOnGreen      = $2E;          WhiteOnGreen       = $2F;
  127.         YellowOnCyan       = $3E;          WhiteOnCyan        = $3F;
  128.         YellowOnRed        = $4E;          WhiteOnRed         = $4F;
  129.         YellowOnMagenta    = $5E;          WhiteOnMagenta     = $5F;
  130.         YellowOnBrown      = $6E;          WhiteOnBrown       = $6F;
  131.         YellowOnLtGray     = $7E;          WhiteOnLtGray      = $7F;
  132.  
  133. type
  134.   Orientation = (Vertical, Horizontal);
  135.  
  136. function SelectColors(Row, Col, BegAttr : byte;
  137.                       CpFrameChars      : FrameArray;
  138.                       Orient            : Orientation;
  139.                       ErasePanelOnExit,
  140.                       EraseCursorOnExit,
  141.                       WrapCursor        : boolean;
  142.                       Header  : string) : byte;
  143. {
  144.     *   Displays a 16x8 panel of text colors with the window coordinates
  145.         of the upper left corner at coordinates X=Col, Y=Row.
  146.     *   The attribute at which the cursor will be initially placed is
  147.         at BegAttr.
  148.     *   The color panel will be framed using the characters specified
  149.         in CpFrameChars.
  150.     *   Allows the user to navigate the panel with the arrow keys and
  151.         select the desired color combination by pressing <CR>. The user
  152.         can also press <INS>, which will return a function value of $FF,
  153.         and by convention, should be taken to indicate that the currently
  154.         selected attribute value is to be unchanged. Additionally, the
  155.         user can press <ESC>, returning a function value of $FE, which by
  156.         convention should be taken to indicate that the current color
  157.         selection run is completed. Finally, a return of $FD indicates
  158.         that the user has pressed the <F1> key either alone or in com-
  159.         bination with one of the shift-type keys (<L-SHIFT>, <R-SHIFT>,
  160.         <CTRL>, or <ALT>), and by convention indicates that the user is
  161.         requesting help.
  162.     *   ErasePanelOnExit determines whether the panel is erased or preserved
  163.         on the screen when SelectColors returns to the caller.
  164.         The panel is always disposed, and its heap space reclaimed.
  165.     *   EraseCursorOnExit is only effective if ErasePanelOnExit is false.
  166.         If the panel is to be preserved between calls to SelectColors,
  167.         EraseCursor determines whether the or not the cursor will continue
  168.         to be displayed along with the panel.
  169.     *   WrapCursor determines whether the cursor will wrap both horizontally
  170.         and vertically. True allows the cursor to wrap; False inhibits
  171.         further cursor movement when a window edge is reached.
  172.     *   Header is the header line which will be displayed on the panel. It
  173.         can be supplied as an empty string (''), in which case no header
  174.         will be displayed.
  175.     *   The function returns a normal text attribute byte, but with the
  176.         following exceptions:
  177.  
  178.     Return  Explanation
  179.     ------  -----------
  180.     $FF     <INS> was pressed by the user. Leave the current value
  181.             unchanged.
  182.     $FE     <ESC> was pressed by the user. Accept all current values
  183.             and consider the run completed.
  184.     $FD     <F1> was pressed by the user. Provide a HELP screen or
  185.             message.
  186.     $F0     Error in MakeWindow
  187.     $F1     Error in DisplayWindow
  188.  
  189. }
  190.  
  191. function ColorName(Attr  : byte) : string;
  192. {   Given a text attribute byte, ColorName returns the attribute color
  193.     name as defined above; e.g., ColorName($1E) will return 'YellowOnBlue'.
  194.     If a byte value is passed which does not correspond to a valid text
  195.     attribute, an empty string is returned.
  196. }
  197.  
  198. function Cstr2Byte(Cstr : string) : byte;
  199. {Given a valid input color name, return the corresponding byte value}
  200.  
  201. Implementation
  202.  
  203. function SelectColors(Row, Col, BegAttr : byte;
  204.                       CpFrameChars      :FrameArray;
  205.                       Orient            : Orientation;
  206.                       ErasePanelOnExit,
  207.                       EraseCursorOnExit,
  208.                       WrapCursor        : boolean;
  209.                       Header  : string) : byte;
  210.   type
  211.     DirectionType = (Up, Down, Left, Right);
  212.   var
  213.     NCols, NRows,
  214.     ColInc, RowInc: byte;
  215.     T1, T2        : integer;
  216.     C1            : char;
  217.     W1            : word;
  218.     WindowBuf     : pointer;
  219.     ColorPanel    : WindowPtr;
  220.     SavFrameChars : FrameArray;
  221.     EraseP        : boolean;
  222.   procedure MoveCursorBlock(Direction : DirectionType);
  223.     begin
  224.       FastWriteWindow(' X ', WhereY, WhereX, ReadAttrAtCursor);
  225.       case WrapCursor of
  226.         true  :
  227.           case Direction of
  228.             Down  : GoToXY(WhereX, (WhereY mod NRows) + 1);
  229.             Up    : GoToXY(WhereX, NRows - ((RowInc - WhereY) mod NRows));
  230.             Left  : GoToXY((WhereX-3 + (3*NCols)) mod (3*NCols), WhereY);
  231.             Right : GoToXY((WhereX+3 + (3*NCols)) mod (3*NCols), WhereY);
  232.             end; {case Direction}
  233.         false :
  234.           case Direction of
  235.             Down  : GoToXY(WhereX, WhereY+1);
  236.             Up    : GoToXY(WhereX, WhereY-1);
  237.             Left  : GoToXY(WhereX-3, WhereY);
  238.             Right : GoToXY(WhereX+3, WhereY);
  239.             end; {case Direction}
  240.         end; {case WrapCursor}
  241.       FastWriteWindow('[X]', WhereY, WhereX, ReadAttrAtCursor);
  242.       end; {MoveCursorBlock}
  243.   begin {SelectColors}
  244.     {Calculate window dimensions based on orientation}
  245.     case Orient of
  246.       Vertical    : begin
  247.         NCols := 8;
  248.         NRows := 16;
  249.         end;
  250.       Horizontal  : begin
  251.         NCols := 16;
  252.         NRows := 8;
  253.         end;
  254.       end; {case Orient}
  255.     ColInc := 3 * NCols + 1;
  256.     RowInc := NRows + 1;
  257.  
  258.     {Check position parameters}
  259.     if Row = 0 then
  260.       Row := (ScreenHeight - RowInc) shr 1;
  261.     if Col = 0 then
  262.       Col := (ScreenWidth - ColInc) shr 1;
  263.     if (Row+RowInc > ScreenHeight) then
  264.       Row := ScreenHeight - RowInc;
  265.     if (Col+ColInc > ScreenWidth) then
  266.       Col := ScreenWidth - ColInc;
  267.  
  268.     {General housekeeping}
  269.     HiddenCursor;
  270.     SavFrameChars := FrameChars;
  271.  
  272.     {Set frame as specified in call}
  273.     FrameChars := CpFrameChars;
  274.  
  275.     {Build the color panel}
  276.     if not MakeWindow(ColorPanel, Col, Row, Col+ColInc, Row+RowInc,
  277.                   true, false, false,
  278.                   $07, $07, $07, Header) then begin
  279.       SelectColors := $F0;
  280.       NormalCursor;
  281.       FrameChars := SavFrameChars;
  282.       exit;
  283.       end;
  284.     if not DisplayWindow(ColorPanel) then begin
  285.       SelectColors := $F1;
  286.       NormalCursor;
  287.       FrameChars := SavFrameChars;
  288.       exit;
  289.       end;
  290.     for T1 := 0 to NRows-1 do
  291.       for T2 := 0 to NCols-1 do
  292.         case Orient of
  293.           Vertical    : FastWriteWindow
  294.                           (' X ', T1+1, 3*T2+1, ((T2 shl 4) + T1));
  295.           Horizontal  : FastWriteWindow
  296.                           (' X ', T1+1, 3*T2+1, ((T1 shl 4) + T2));
  297.           end; {case Orient}
  298.  
  299.     {Place the cursor as specified in call}
  300.     case Orient of
  301.       Vertical    : GoToXY(3*(BegAttr shr 4)+1, (BegAttr and $0F)+1);
  302.       Horizontal  : GoToXY(3*(BegAttr and $0F)+1, (BegAttr shr 4)+1);
  303.       end;
  304.     FastWriteWindow('[X]',WhereY, WhereX,ReadAttrAtCursor);
  305.  
  306.     {Select the desired color attribute}
  307.     repeat
  308.       W1 := ReadKeyWord;
  309.       case W1 of
  310.         $4800:  begin                       {UpArrow}
  311.                   MoveCursorBlock(Up);
  312.                   end;
  313.         $4B00:  begin                       {LtArrow}
  314.                   MoveCursorBlock(Left);
  315.                   end;
  316.         $4D00:  begin                       {RtArrow}
  317.                   MoveCursorBlock(Right);
  318.                   end;
  319.         $5000:  begin                       {DnArrow}
  320.                   MoveCursorBlock(Down);
  321.                   end;
  322.         end; {case}
  323.       until (W1 = $1C0D {<CR >}) or
  324.             (W1 = $5200 {<INS>}) or
  325.             (W1 = $011B {<ESC>}) or
  326.             (W1 = $3B00 {<F1> }) or
  327.             (W1 = $5400 {<#F1>}) or
  328.             (W1 = $5E00 {<^F1>}) or
  329.             (W1 = $6800 {<@F1>});
  330.  
  331.     {Conditionally save the panel}
  332.     case ErasePanelOnExit of
  333.       false :
  334.         {Conditionally clear the cursor block after selection}
  335.         begin
  336.           case EraseCursorOnExit of
  337.             false : {Do nothing}  ;
  338.             true  :
  339.               begin
  340.                 FastWriteWindow(' X ',WhereY, WhereX, ReadAttrAtCursor);
  341.                 end;
  342.             end; {case EraseCursorOnExit}
  343.           if SaveWindow
  344.             (Col, Row, Col+ColInc, Row+RowInc, true, WindowBuf) then ;
  345.           end; {false}
  346.       true  : {Do nothing}  ;
  347.       end; {case ErasePanelOnExit}
  348.  
  349.     {Set up the return}
  350.     case W1 of
  351.       $5200 {<INS>} : SelectColors := $FF;
  352.       $011B {<ESC>} : SelectColors := $FE;
  353.       $3B00,{<F1> }
  354.       $5400,{<#F1>}
  355.       $5E00,{<^F1>}
  356.       $6800 {<@F1>} : SelectColors := $FD;
  357.       else            begin
  358.                         byte(C1) := ReadAttrAtCursor;
  359.                         SelectColors := byte(C1);
  360.                         end;
  361.       end; {case W1}
  362.  
  363.     {Dispose of the window and conditionally restore the panel}
  364.     DisposeWindow(EraseTopWindow);
  365.     if not ErasePanelOnExit then
  366.       RestoreWindow(Col, Row, Col+ColInc, Row+RowInc, true, WindowBuf);
  367.  
  368.     {Restore the environment and scram}
  369.     NormalCursor;
  370.     FrameChars := SavFrameChars;
  371.    end;
  372.  
  373. function ColorName(Attr  : byte) : string;
  374.   begin
  375.     case Attr of
  376.  
  377.       {Black text}
  378.       $00 : ColorName := 'BlackOnBlack';
  379.       $10 : ColorName := 'BlackOnBlue';
  380.       $20 : ColorName := 'BlackOnGreen';
  381.       $30 : ColorName := 'BlackOnCyan';
  382.       $40 : ColorName := 'BlackOnRed';
  383.       $50 : ColorName := 'BlackOnMagenta';
  384.       $60 : ColorName := 'BlackOnBrown';
  385.       $70 : ColorName := 'BlackOnLtGray';
  386.  
  387.             {Blue text}
  388.       $01 : ColorName := 'BlueOnBlack';
  389.       $11 : ColorName := 'BlueOnBlue';
  390.       $21 : ColorName := 'BlueOnGreen';
  391.       $31 : ColorName := 'BlueOnCyan';
  392.       $41 : ColorName := 'BlueOnRed';
  393.       $51 : ColorName := 'BlueOnMagenta';
  394.       $61 : ColorName := 'BlueOnBrown';
  395.       $71 : ColorName := 'BlueOnLtGray';
  396.  
  397.             {Green text}
  398.       $02 : ColorName := 'GreenOnBlack';
  399.       $12 : ColorName := 'GreenOnBlue';
  400.       $22 : ColorName := 'GreenOnGreen';
  401.       $32 : ColorName := 'GreenOnCyan';
  402.       $42 : ColorName := 'GreenOnRed';
  403.       $52 : ColorName := 'GreenOnMagenta';
  404.       $62 : ColorName := 'GreenOnBrown';
  405.       $72 : ColorName := 'GreenOnLtGray';
  406.  
  407.             {Cyan text}
  408.       $03 : ColorName := 'CyanOnBlack';
  409.       $13 : ColorName := 'CyanOnBlue';
  410.       $23 : ColorName := 'CyanOnGreen';
  411.       $33 : ColorName := 'CyanOnCyan';
  412.       $43 : ColorName := 'CyanOnRed';
  413.       $53 : ColorName := 'CyanOnMagenta';
  414.       $63 : ColorName := 'CyanOnBrown';
  415.       $73 : ColorName := 'CyanOnLtGray';
  416.  
  417.             {Red text}
  418.       $04 : ColorName := 'RedOnBlack';
  419.       $14 : ColorName := 'RedOnBlue';
  420.       $24 : ColorName := 'RedOnGreen';
  421.       $34 : ColorName := 'RedOnCyan';
  422.       $44 : ColorName := 'RedOnRed';
  423.       $54 : ColorName := 'RedOnMagenta';
  424.       $64 : ColorName := 'RedOnBrown';
  425.       $74 : ColorName := 'RedOnLtGray';
  426.  
  427.             {Magenta text}
  428.       $05 : ColorName := 'MagentaOnBlack';
  429.       $15 : ColorName := 'MagentaOnBlue';
  430.       $25 : ColorName := 'MagentaOnGreen';
  431.       $35 : ColorName := 'MagentaOnCyan';
  432.       $45 : ColorName := 'MagentaOnRed';
  433.       $55 : ColorName := 'MagentaOnMagenta';
  434.       $65 : ColorName := 'MagentaOnBrown';
  435.       $75 : ColorName := 'MagentaOnLtGray';
  436.  
  437.             {Brown text}
  438.       $06 : ColorName := 'BrownOnBlack';
  439.       $16 : ColorName := 'BrownOnBlue';
  440.       $26 : ColorName := 'BrownOnGreen';
  441.       $36 : ColorName := 'BrownOnCyan';
  442.       $46 : ColorName := 'BrownOnRed';
  443.       $56 : ColorName := 'BrownOnMagenta';
  444.       $66 : ColorName := 'BrownOnBrown';
  445.       $76 : ColorName := 'BrownOnLtGray';
  446.  
  447.             {Light Gray text}
  448.       $07 : ColorName := 'LtGrayOnBlack';
  449.       $17 : ColorName := 'LtGrayOnBlue';
  450.       $27 : ColorName := 'LtGrayOnGreen';
  451.       $37 : ColorName := 'LtGrayOnCyan';
  452.       $47 : ColorName := 'LtGrayOnRed';
  453.       $57 : ColorName := 'LtGrayOnMagenta';
  454.       $67 : ColorName := 'LtGrayOnBrown';
  455.       $77 : ColorName := 'LtGrayOnLtGray';
  456.  
  457.             {Dark Gray text}
  458.       $08 : ColorName := 'DkGrayOnBlack';
  459.       $18 : ColorName := 'DkGrayOnBlue';
  460.       $28 : ColorName := 'DkGrayOnGreen';
  461.       $38 : ColorName := 'DkGrayOnCyan';
  462.       $48 : ColorName := 'DkGrayOnRed';
  463.       $58 : ColorName := 'DkGrayOnMagenta';
  464.       $68 : ColorName := 'DkGrayOnBrown';
  465.       $78 : ColorName := 'DkGrayOnLtGray';
  466.  
  467.             {Light Blue text}
  468.       $09 : ColorName := 'LtBlueOnBlack';
  469.       $19 : ColorName := 'LtBlueOnBlue';
  470.       $29 : ColorName := 'LtBlueOnGreen';
  471.       $39 : ColorName := 'LtBlueOnCyan';
  472.       $49 : ColorName := 'LtBlueOnRed';
  473.       $59 : ColorName := 'LtBlueOnMagenta';
  474.       $69 : ColorName := 'LtBlueOnBrown';
  475.       $79 : ColorName := 'LtBlueOnLtGray';
  476.  
  477.             {Light Green Text}
  478.       $0A : ColorName := 'LtGreenOnBlack';
  479.       $1A : ColorName := 'LtGreenOnBlue';
  480.       $2A : ColorName := 'LtGreenOnGreen';
  481.       $3A : ColorName := 'LtGreenOnCyan';
  482.       $4A : ColorName := 'LtGreenOnRed';
  483.       $5A : ColorName := 'LtGreenOnMagenta';
  484.       $6A : ColorName := 'LtGreenOnBrown';
  485.       $7A : ColorName := 'LtGreenOnLtGray';
  486.  
  487.             {Light Cyan text}
  488.       $0B : ColorName := 'LtCyanOnBlack';
  489.       $1B : ColorName := 'LtCyanOnBlue';
  490.       $2B : ColorName := 'LtCyanOnGreen';
  491.       $3B : ColorName := 'LtCyanOnCyan';
  492.       $4B : ColorName := 'LtCyanOnRed';
  493.       $5B : ColorName := 'LtCyanOnMagenta';
  494.       $6B : ColorName := 'LtCyanOnBrown';
  495.       $7B : ColorName := 'LtCyanOnLtGray';
  496.  
  497.             {Light Red text}
  498.       $0C : ColorName := 'LtRedOnBlack';
  499.       $1C : ColorName := 'LtRedOnBlue';
  500.       $2C : ColorName := 'LtRedOnGreen';
  501.       $3C : ColorName := 'LtRedOnCyan';
  502.       $4C : ColorName := 'LtRedOnRed';
  503.       $5C : ColorName := 'LtRedOnMagenta';
  504.       $6C : ColorName := 'LtRedOnBrown';
  505.       $7C : ColorName := 'LtRedOnLtGray';
  506.  
  507.             {Light Magenta text}
  508.       $0D : ColorName := 'LtMagentaOnBlack';
  509.       $1D : ColorName := 'LtMagentaOnBlue';
  510.       $2D : ColorName := 'LtMagentaOnGreen';
  511.       $3D : ColorName := 'LtMagentaOnCyan';
  512.       $4D : ColorName := 'LtMagentaOnRed';
  513.       $5D : ColorName := 'LtMagentaOnMagenta';
  514.       $6D : ColorName := 'LtMagentaOnBrown';
  515.       $7D : ColorName := 'LtMagentaOnLtGray';
  516.  
  517.             {Yellow text}
  518.       $0E : ColorName := 'YellowOnBlack';
  519.       $1E : ColorName := 'YellowOnBlue';
  520.       $2E : ColorName := 'YellowOnGreen';
  521.       $3E : ColorName := 'YellowOnCyan';
  522.       $4E : ColorName := 'YellowOnRed';
  523.       $5E : ColorName := 'YellowOnMagenta';
  524.       $6E : ColorName := 'YellowOnBrown';
  525.       $7E : ColorName := 'YellowOnLtGray';
  526.  
  527.             {White text}
  528.       $0F : ColorName := 'WhiteOnBlack';
  529.       $1F : ColorName := 'WhiteOnBlue';
  530.       $2F : ColorName := 'WhiteOnGreen';
  531.       $3F : ColorName := 'WhiteOnCyan';
  532.       $4F : ColorName := 'WhiteOnRed';
  533.       $5F : ColorName := 'WhiteOnMagenta';
  534.       $6F : ColorName := 'WhiteOnBrown';
  535.       $7F : ColorName := 'WhiteOnLtGray';
  536.  
  537.       else  ColorName := '';
  538.       end;
  539.     end; {ColorName}
  540.  
  541. function Cstr2Byte(Cstr : string) : byte;
  542. {Given a valid input color name, return the corresponding byte value}
  543.   const
  544.     BVal  : array[0..$07] of string[10] =  (
  545.       'BLACK'     ,    'BLUE'      ,    'GREEN'     ,
  546.       'CYAN'      ,    'RED'       ,    'MAGENTA'   ,
  547.       'BROWN'     ,    'LTGRAY'    );
  548.     FVal  : array[0..$F] of string[10] =   (
  549.       'BLACK'     ,    'BLUE'      ,    'GREEN'     ,
  550.       'CYAN'      ,    'RED'       ,    'MAGENTA'   ,
  551.       'BROWN'     ,    'LTGRAY'    ,
  552.       'DKGRAY'    ,    'LTBLUE'    ,    'LTGREEN'   ,
  553.       'LTCYAN'    ,    'LTRED'     ,    'LTMAGENTA' ,
  554.       'YELLOW'    ,    'WHITE'     );
  555.   var
  556.     b1,
  557.     F,
  558.     B   : byte;
  559.     FS,
  560.     BS  : string[10];
  561.   begin
  562.     b1 := pos('ON', StUpcase(Cstr));
  563.     FS := StUpcase(copy(Cstr, 1, pred(b1)));
  564.     BS := StUpcase(copy(Cstr, b1+2, 255));
  565.     F := 0;
  566.     while (FS <> Fval[F]) and (F <= $0F) do
  567.       inc(F);
  568.     B := 0;
  569.     while (BS <> Bval[B]) and (B <= $07) do
  570.       inc(B);
  571.     if (F > $0F) or (B > $07) then
  572.       Cstr2Byte := $FF
  573.     else
  574.       Cstr2Byte := (B shl 4) xor F;
  575.     end; {Cstr2Byte}
  576.   end.
  577.